#!/usr/bin/perl


package Mjan;

use strict;
use warnings;

use Exporter;

require Exporter;
our(@ISA, @EXPORT_OK, $VERSION);
@ISA = qw/ Exporter /;
@EXPORT_OK = qw/ hantei /;
$VERSION = "0.01";

@EXPORT_OK = qw/ hantei /;

sub hantei
{
	my ($param) = @_;
	my %result;
	my $rc = 0;
	my @yakulist;
	
	# 引数初期化
	my $tgt        = $param->{target};    # 必須
	my $agari_hai = $param->{agari_hai}; # 必須
	
	
	
	# 役判定
	# 七対子（チートイツ）判定
	# 国士無双（コクシムソウ）判定
	# 
	
	# 刻子、順子優先それぞれ評価
	my ($c_rc, @c_mentsu) = hantei_cous($tgt);
	my ($j_rc, @j_mentsu) = hantei_juns($tgt);
	
	if ( $c_rc or $j_rc ) {
		
		# 上がり判定成功
		#   役なければ 0 にする？
		$rc = 1;
		
		# 組み合わせができている
		if ($c_rc) {
			foreach my $line ( @c_mentsu ) {
#					print $line;
			}
		}
		if ($j_rc) {
			foreach my $line ( @c_mentsu ) {
#					print $line;
			}
		}
		
		# <役判定>
		#    一翻
		# 立直（リーチ）
		# 一発（いっぱつ）
		# 門前清自摸和（メンゼンチンツモホウ）
		# 断?九（タンヤオチュー）
		if ( is_tanyao(\@j_mentsu) ) {
			push @yakulist, "TANYAO"
		}
		
		# 平和（ピンフ）
		if ( is_pinhu(\@j_mentsu, $agari_hai) ) {
			
			# 鳴いていたら取り消し
			
			
			push @yakulist, "PINHU";
		}
		# 一盃口（イーペーコー）
		# 自風牌
		# 場風牌
		# 白
		# 發
		# 中
		# 嶺上開花（リンシャンカイホウ）
		# 槍槓（チャンカン）
		# 海底摸月（ハイテイモーユエ）
		# 河底撈魚（ホーテイラオユイ）
		# 
		#    二翻
		# 三色同順 	サンショクドウジュン
		# 一気通貫（イッキツウカン）
		# 混全帯?九 	ホンチャンタイヤオチュー
		# 七対子 	チートイツ
		# 対々和 	トイトイホー
		# 三暗刻 	サンアンコー
		# 混老頭 	ホンロウトー
		# 三色同刻 	サンショクドーコー
		# 三槓子 	サンカンツ
		# 小三元 	ショウサンゲン
		# ダブル立直 	ダブルリーチ
		#
		#    三翻
		# 混一色 	ホンイーソー
		# 純全帯?九 	ジュンチャンタイヤオチュー
		# 二盃口 	リャンペーコー
		#
		#    六飜
		# 清一色 	チンイーソー
		#
		#    役満
		# 国士無双 	コクシムソウ
		# 四暗刻（スーアンコー）
		# if (is_suanko() ) {
		#	
		#	# ロンなら四暗刻にならない。
		#}
		# 大三元 	ダイサンゲン
		# 字一色 	ツーイーソー
		# 小四喜 	ショウスーシー
		# 大四喜 	ダイスーシー
		# 緑一色 	リューイーソー
		# 清老頭 	チンロートー
		# 四槓子 	スーカンツ
		# 九蓮宝燈 	チューレンポウトー
		# 天和 	テンホウ
		# 地和 	チーホウ
		
	}
	
	$result{YAKU} = \@yakulist;
	
	return ($rc, %result);
}

# ---------------------------------
# 組み合わせができているかチェック
#  牌が整形ソートされていること必須
#  刻子優先モード
# ---------------------------------
sub hantei_cous
{
	my ($search_target, $head_hai) = @_;
	
	# 実行速度向上のため正規表現止めたほうがいい？
	my %hash;
	foreach my $hai ( $search_target =~ /\w\d/g ) {
		
		if (exists $hash{$hai}) {
			$hash{$hai}++;
		}
		else{ 
			$hash{$hai}=1;
		}
	}
	
	# 頭候補さがし
	my @heads;
	if ($head_hai) {
		# 頭確定
		push @heads, $head_hai;
	}
	else{
		while (my($k, $v) = each %hash) {
#			print "$k=$v";
			if ($v >= 2) {
				push @heads, $k;
#				print "may head $k";
			}
		}
	}
	
#	print "> hantei start";
	my @mentsu;
	my $rc;
	foreach my $head ( @heads ) {
#		print "-- head $head";
		my %s_hash = %hash;
		$s_hash{$head} -= 2;
		delete $s_hash{$head} if ($s_hash{$head} == 0);
		
		# 初期化
		@mentsu = ("$head,$head");
		
		# 刻子判定（刻子優先）
		while (my ($k, $v) = each %s_hash) {
			if ($v >= 3) {
				$s_hash{$k} -= 3;
				delete $s_hash{$k} if ($s_hash{$k} == 0);
#				print "COT $k $k $k";
				push @mentsu, "$k,$k,$k";
			}
		}
		
		# 順子判定
		# s_hash にキーが無くなれば成功
		my $success = 1;
		while (keys %s_hash != 0) {
			
			# 順子を作る一番若いのを取得
			my ($first) = sort keys %s_hash;
			my ($type, $num) = split //, $first;
			my $second = $type . ($num + 1);
			my $third  = $type . ($num + 2);
			
			# 字牌は順子にならない
			if ($type eq 'z') {
				$success = 0;
				last;
			}
			
			if (exists $s_hash{$second} && exists $s_hash{$third}) {
#				print "JUN $first $second $third";
				$s_hash{$first}  -= 1;
				$s_hash{$second} -= 1;
				$s_hash{$third}  -= 1;
				
				delete $s_hash{$first}  if $s_hash{$first}  == 0;
				delete $s_hash{$second} if $s_hash{$second} == 0;
				delete $s_hash{$third}  if $s_hash{$third}  == 0;
				
				push @mentsu, "$first,$second,$third";
			}
			else{
				# faild
				$success = 0;
				last;
			}
		}
		
		if ($success == 1) {
#			print "ok!";
			$rc = 1;
			last;
		}
		else{
#			print "faild";
		}
		
	}
	
	return ($rc, @mentsu);
}
# ---------------------------------
# 組み合わせができているかチェック
#  牌が整形ソートされていること必須
#  順子優先モード
# ---------------------------------
sub hantei_juns
{
	my ($search_target, $head_hai) = @_;
	
	# 実行速度向上のため正規表現止めたほうがいい？
	my %hash;
	foreach my $hai ( $search_target =~ /\w\d/g ) {
		
		if (exists $hash{$hai}) {
			$hash{$hai}++;
		}
		else{ 
			$hash{$hai}=1;
		}
	}
	
	# 頭候補さがし
	my @heads;
	if ($head_hai) {
		# 頭確定
		push @heads, $head_hai;
	}
	else{
		while (my($k, $v) = each %hash) {
#			print "$k=$v";
			if ($v >= 2) {
				push @heads, $k;
#				print "may head $k";
			}
		}
	}
	
#	print "> hantei start";
	my @mentsu;
	my $rc;
	foreach my $head ( @heads ) {
#		print "-- head $head";
		my %s_hash = %hash;
		$s_hash{$head} -= 2;
		delete $s_hash{$head} if ($s_hash{$head} == 0);
		
		# 初期化
		@mentsu = ("$head,$head");
		
		# 順子判定（順子優先）
		while (keys %s_hash != 0) {
			
			# 順子を作る一番若いのを取得 ソートに m,s,p < z 必須
			my ($first) = sort keys %s_hash;
			
			my ($type, $num) = split //, $first;
			my $second = $type . ($num + 1);
			my $third  = $type . ($num + 2);
			
			# 字牌は順子にならない
			if ($type eq 'z') {
				last;
			}
			
			if (exists $s_hash{$second} && exists $s_hash{$third}) {
#				print "JUN $first $second $third";
				$s_hash{$first}  -= 1;
				$s_hash{$second} -= 1;
				$s_hash{$third}  -= 1;
				
				delete $s_hash{$first}  if $s_hash{$first}  == 0;
				delete $s_hash{$second} if $s_hash{$second} == 0;
				delete $s_hash{$third}  if $s_hash{$third}  == 0;
				
				push @mentsu, "$first,$second,$third";
			}
			else{
				# faild
				last;
			}
		}
		
		# 刻子判定
		while (my ($k, $v) = each %s_hash) {
			if ($v >= 3) {
				$s_hash{$k} -= 3;
				delete $s_hash{$k} if ($s_hash{$k} == 0);
#				print "COT $k $k $k";
				push @mentsu, "$k,$k,$k";
			}
		}
		
		if (keys %s_hash == 0) {
			$rc = 1;
			last;
		}
	}
	
	return ($rc, @mentsu);
}


# 
# 平和
# 
# 天和時の判定も上がり牌を必要としておく。（処理が面倒なので）
# 
# 
# 123 234 *** *** **
# 123 *** *** *** 11
# *** *** *** *** 南南
sub is_pinhu
{
	my ($mentsu, $agari_hai, $jikaze, $bakaze) = @_;
	my $is_head    = 1; # 頭
	my $is_ryoumen = 0; # 両面待ち （両面待ちで無いを判定しないので初期値は0）
	
	foreach my $line ( @$mentsu ) {
		my ($first, $second, $third) = split /\,/, $line;
		
		if (defined $third) {
			# if 順子である（面子が順子で渡ってくるので省略）
			
			# 両面待ちかどうか
			if ($first eq $agari_hai or $second eq $agari_hai) {
				$is_ryoumen = 1;
			}
			# --------------------------------------------------------
			# この条件だと
			# 123 234 *** *** ** で上がり牌が 2 の時成立を逃してしまう
			#if ($first eq $second) {
			#	$rc = 0;
			#	last;
			#}
			# --------------------------------------------------------
			
		}
		else{
			# 頭
			
			# 頭がオタ風か1..9ならok
			# z5:白 z6:發 z7:中
			if ($first =~ /$jikaze|$bakaze|z5|z6|z7/) {
				$is_head = 0;
				last;
			}
			else{
				$is_head = 1;
			}
		}
	}
	
	if ($is_head and $is_ryoumen) {
		return 1;
	}
	return 0;
}

# タンヤオ
sub is_tanyao
{
	my ($mentsu) = @_;
	my $rc=1;
	
	foreach my $line ( @$mentsu ) {
		$rc = 0 if ($line =~ /1|9|z/);
	}
	
	return $rc;
}

1;
